﻿Imports System.Text
Imports System.Net
Imports System.Net.Sockets
Imports System.Threading
Imports System.Threading.Tasks
Imports System.Collections.Concurrent

Public Class TCPServerAsync
    ''' <summary>
    ''' 最大接收连接数
    ''' </summary>
    Private m_Connection_LimitMax As Integer
    ''' <summary>
    ''' 缓冲区管理器
    ''' </summary>
    Private m_bufferManager As BufferManager
    ''' <summary>
    ''' 每个连接可用缓冲区数量（读写各一个）
    ''' </summary>
    Const opsToPreAlloc As Integer = 2
    ''' <summary>
    ''' 服务器Socket
    ''' </summary>
    Private listenSocket As Socket
    ''' <summary>
    ''' 客户端读写异步事件对象缓冲区
    ''' </summary>
    Private m_readWritePool As SocketAsyncEventArgsPool
    ''' <summary>
    ''' 总接收到的数据包数量
    ''' </summary>
    Private m_totalBytesRead As Long
    ''' <summary>
    ''' 当前客户端连接数
    ''' </summary>
    Private m_numConnectedSockets As Integer
    ''' <summary>
    ''' 监听线程等待模型，当连接达到一定数量后，阻塞监听。
    ''' </summary>
    Private m_maxNumberAcceptedClients As Semaphore

    ''' <summary>
    ''' 客户端连接信息
    ''' </summary>
    Private mClients As ConcurrentDictionary(Of String, AsyncClientToken)
    ''' <summary>
    ''' 服务是否已启动
    ''' </summary>
    Private mServerIsRun As Boolean

    ''' <summary>
    ''' 服务器已启动事件
    ''' </summary>
    Public Event ServerStartEvent As EventHandler
    ''' <summary>
    ''' 服务器已关闭事件
    ''' </summary>
    Public Event ServerCloseEvent As EventHandler

    ''' <summary>
    ''' 客户端连接接入事件
    ''' </summary>
    Public Event ClientAcceptEvent As EventHandler

    ''' <summary>
    ''' 接收到的客户端消息事件
    ''' </summary>
    Public Event ClientReceiveEvent As EventHandler

    ''' <summary>
    ''' 发送消息到客户端完毕事件
    ''' </summary>
    Public Event ClientSendOverEvent As EventHandler

    ''' <summary>
    ''' 客户端已关闭连接
    ''' </summary>
    Public Event ClientCloseEvent As EventHandler



    ''' <summary>
    ''' 当前服务器监听的终结点
    ''' </summary>
    Private mListenEndPoint As IPEndPoint

    ''' <summary>
    ''' 获取客户端数量
    ''' </summary>
    ''' <returns></returns>
    Public ReadOnly Property ClientCount
        Get
            Return m_numConnectedSockets
        End Get
    End Property

    ''' <summary>
    ''' 总接收到的数据包数量
    ''' </summary>
    Public ReadOnly Property TotalBytesRead
        Get
            Return m_totalBytesRead
        End Get
    End Property


    ''' <summary>
    ''' 获取当前服务器监听的终结点
    ''' </summary>
    ''' <returns></returns>
    Public ReadOnly Property ListenEndPoit
        Get
            Return mListenEndPoint
        End Get
    End Property
    ''' <summary>
    ''' 创建一个TCP服务器
    ''' </summary>
    ''' <param name="numConnections">最大连接数</param>
    Public Sub New(ByVal numConnections As Integer)
        Me.New(numConnections, New BufferManager())
    End Sub


    ''' <summary>
    ''' 创建一个TCP服务器
    ''' </summary>
    ''' <param name="numConnections">最大连接数</param>
    ''' <param name="bufManage">缓冲区管理器</param>
    Public Sub New(ByVal numConnections As Integer,
                   ByVal bufManage As BufferManager)
        m_totalBytesRead = 0
        m_numConnectedSockets = 0
        m_Connection_LimitMax = numConnections
        m_bufferManager = bufManage
        m_readWritePool = New SocketAsyncEventArgsPool(numConnections)
        m_maxNumberAcceptedClients = New Semaphore(numConnections, numConnections)
        mListenEndPoint = Nothing
        mServerIsRun = False

        Init()
    End Sub

    ''' <summary>
    ''' 初始化连接信息，预创建连接 EventArgs 和 内存缓冲区
    ''' </summary>
    Private Sub Init()
        mClients = New ConcurrentDictionary(Of String, AsyncClientToken)

        For i As Integer = 0 To 128
            m_readWritePool.Push(CreatereadWriteEventArg())
        Next
    End Sub

    Private Function CreatereadWriteEventArg() As SocketAsyncEventArgs
        Dim readWriteEventArg = New SocketAsyncEventArgs()
        readWriteEventArg.DisconnectReuseSocket = True
        AddHandler readWriteEventArg.Completed, AddressOf IO_Completed
        Return readWriteEventArg
    End Function


    Private Function GetEventArg() As SocketAsyncEventArgs
        SyncLock m_readWritePool
            Dim oEventArgs As SocketAsyncEventArgs = m_readWritePool.Pop()
            If oEventArgs Is Nothing Then
                oEventArgs = CreatereadWriteEventArg()
            End If
            If (oEventArgs.UserToken IsNot Nothing) Then
                Dim oToken As AsyncClientToken = oEventArgs.UserToken
                If Not String.IsNullOrEmpty(oToken.ClientID) Then
                    Trace.WriteLine(oToken.ClientID)
                End If

            End If
            Return oEventArgs
        End SyncLock


    End Function

    ''' <summary>
    ''' 启动服务器
    ''' </summary>
    ''' <param name="localEndPoint">服务器监听终结点</param>
    Public Sub Start(ByVal localEndPoint As IPEndPoint)
        If mServerIsRun Then
            Throw New Exception("服务已启动，不可重复启动")
        End If
        mListenEndPoint = Nothing
        m_numConnectedSockets = 0
        mServerIsRun = False
        listenSocket = New Socket(localEndPoint.AddressFamily, SocketType.Stream, ProtocolType.Tcp)
        mClients.Clear()

        listenSocket.Bind(localEndPoint)
        listenSocket.Listen(100)
        mServerIsRun = True
        mListenEndPoint = localEndPoint
        Task.Run(Sub()
                     StartAccept(Nothing)
                 End Sub)

        RaiseEvent ServerStartEvent(Me, Nothing)
    End Sub

#Region "接收客户端连接"
    ''' <summary>
    ''' 开始接收客户端
    ''' </summary>
    ''' <param name="acceptEventArg"></param>
    Public Sub StartAccept(ByVal acceptEventArg As SocketAsyncEventArgs)
        If acceptEventArg Is Nothing Then
            acceptEventArg = New SocketAsyncEventArgs()
            AddHandler acceptEventArg.Completed, AddressOf AcceptEventArg_Completed
        Else
            acceptEventArg.AcceptSocket = Nothing
        End If

        m_maxNumberAcceptedClients.WaitOne() '判断线程有没有用完，没有用完就继续，用完了就等待
        Dim willRaiseEvent As Boolean = listenSocket.AcceptAsync(acceptEventArg)

        If Not willRaiseEvent Then
            ProcessAccept(acceptEventArg)
        End If
    End Sub

    ''' <summary>
    ''' 客户端连接事件
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    Private Sub AcceptEventArg_Completed(ByVal sender As Object, ByVal e As SocketAsyncEventArgs)
        ProcessAccept(e)
    End Sub


    ''' <summary>
    ''' 已收到客户端连接请求，加入到客户端列表
    ''' </summary>
    ''' <param name="e"></param>
    Private Sub ProcessAccept(ByVal e As SocketAsyncEventArgs)
        If (e.SocketError = SocketError.Success) Then

            Interlocked.Increment(m_numConnectedSockets) '连接数加1

            Dim readEventArgs As SocketAsyncEventArgs = GetEventArg()
            If readEventArgs.UserToken Is Nothing Then
                readEventArgs.UserToken = New AsyncClientToken
            End If
            Dim UserToken = TryCast(readEventArgs.UserToken, AsyncClientToken)
            Dim oClientSocket = e.AcceptSocket

            Dim sKey = Guid.NewGuid.ToString("N")
            UserToken.SetToken(sKey, oClientSocket)
            mClients.TryAdd(sKey, UserToken)
            Dim buf = m_bufferManager.GetBuffer()
            UserToken.Buffer = buf
            readEventArgs.SetBuffer(buf.Buffer, buf.Offset, buf.Size)


            '准备从客户端接收消息

            RaiseEvent ClientAcceptEvent(Me, New ClientEventArgs(UserToken))
            StartReceive(readEventArgs)


            StartAccept(e)
        Else
            '服务器关闭监听
            e.Dispose()
            mServerIsRun = False

        End If
    End Sub


    Private Sub IO_Completed(ByVal sender As Object, ByVal e As SocketAsyncEventArgs)
        Select Case e.LastOperation
            Case SocketAsyncOperation.Receive
                ProcessReceive(e)
            Case SocketAsyncOperation.Send
                ProcessSend(e)
            Case Else
                Throw New ArgumentException("在套接字上完成的最后一个操作不是接收或发送")
        End Select
    End Sub
#End Region


#Region "接收客户端消息"


    ''' <summary>
    ''' 开始接收客户端消息
    ''' </summary>
    Public Sub StartReceive(ByVal readEventArgs As SocketAsyncEventArgs)
        Dim oToken As AsyncClientToken = TryCast(readEventArgs.UserToken, AsyncClientToken)
        Dim oClient As Socket = oToken.Socket

        '清空接收缓冲区，接续
        readEventArgs.SetBuffer(readEventArgs.Buffer, readEventArgs.Offset, readEventArgs.Count)
        Dim willRaiseEvent As Boolean = oClient.ReceiveAsync(readEventArgs)

        If Not willRaiseEvent Then
            ProcessReceive(readEventArgs)
        End If
    End Sub
    ''' <summary>
    ''' 接收到客户端消息的处理过程
    ''' </summary>
    ''' <param name="e"></param>
    Private Sub ProcessReceive(ByVal e As SocketAsyncEventArgs)
        Dim oToken As AsyncClientToken = TryCast(e.UserToken, AsyncClientToken)
        Dim oClient As Socket = oToken.Socket

        Select Case e.SocketError
            Case SocketError.Success '成功接收到客户端发来的消息
                If (e.BytesTransferred > 0) Then
                    Interlocked.Add(m_totalBytesRead, e.BytesTransferred)

                    oToken.Buffer.ReadableBytes = e.BytesTransferred '设置一下可读区域
                    RaiseEvent ClientReceiveEvent(Me, New ClientEventArgs(oToken))
                    oToken.Buffer.ReadableBytes = 0

                    StartReceive(e)
                Else
                    CloseClientSocket(e) '接收到错误状态，关闭客户端
                End If
            Case SocketError.Disconnecting
                CloseClientSocket(e) '接收到错误状态，关闭客户端
            Case Else
                CloseClientSocket(e) '接收到错误状态，关闭客户端
        End Select

    End Sub
#End Region

#Region "发送客户端消息"
    Public Function GetNewBuf() As BufferChunk
        Return m_bufferManager.GetBuffer()
    End Function

    Public Function FreeBuf(buf As BufferChunk)
        m_bufferManager.FreeBuffer(buf)
    End Function

    ''' <summary>
    ''' 发送消息到客户端
    ''' </summary>
    ''' <param name="sClientKey"></param>
    ''' <param name="Msg"></param>
    Public Function SendMessageToClient(ByVal sClientKey As String, ByVal Msg As String,
                                        ByVal MsgEncoding As Encoding, ByVal bHex As Boolean) As Boolean
        If (String.IsNullOrEmpty(Msg)) Then Return False
        If (String.IsNullOrEmpty(sClientKey)) Then Return False

        Dim oUserToken As AsyncClientToken = Nothing
        If mClients.TryGetValue(sClientKey, oUserToken) Then
            Dim buf = m_bufferManager.GetBuffer()
            If Not bHex Then
                Dim msgBuf = MsgEncoding.GetBytes(Msg)

                buf.WriteBytes(msgBuf)


            Else

                buf = HexToByte(Msg, buf)
            End If
            SendBuffer(oUserToken, buf)
            Return True
        Else
            Return False
        End If

    End Function

    Public Function SendBuffer(ByVal sClientKey As String, bufSend As BufferChunk) As Boolean
        If bufSend Is Nothing Then Return False
        If (String.IsNullOrEmpty(sClientKey)) Then Return False
        If bufSend.ReadableBytes = 0 Then Return False


        Dim oUserToken As AsyncClientToken = Nothing
        If mClients.TryGetValue(sClientKey, oUserToken) Then
            SendBuffer(oUserToken, bufSend)
            Return True
        Else
            Return False
        End If


    End Function

    Private Sub SendBuffer(oUserToken As AsyncClientToken, bufSend As BufferChunk)
        Dim oSendToken As AsyncClientToken
        Dim writeEventArg As SocketAsyncEventArgs = GetEventArg()
        writeEventArg.SetBuffer(bufSend.Buffer, bufSend.Offset, bufSend.ReadableBytes)

        If writeEventArg.UserToken Is Nothing Then
            writeEventArg.UserToken = TryCast(oUserToken.Clone(), AsyncClientToken)
            oSendToken = TryCast(writeEventArg.UserToken, AsyncClientToken)
        Else
            oSendToken = TryCast(writeEventArg.UserToken, AsyncClientToken)
            oSendToken.SetToken(oUserToken.ClientID, oUserToken.Socket)
        End If

        AddHandler writeEventArg.Completed, AddressOf IO_Completed
        writeEventArg.UserToken = oSendToken
        oSendToken.Buffer = bufSend

        StartSend(writeEventArg)

    End Sub

    ''' <summary>
    ''' 开始发送消息
    ''' </summary>
    ''' <param name="writeEventArgs"></param>
    Private Sub StartSend(ByVal writeEventArgs As SocketAsyncEventArgs)
        Dim oToken As AsyncClientToken = TryCast(writeEventArgs.UserToken, AsyncClientToken)
        Dim oClient As Socket = oToken.Socket

        Dim willRaiseEvent As Boolean = oClient.SendAsync(writeEventArgs)

        If Not willRaiseEvent Then
            ProcessSend(writeEventArgs)
        End If
    End Sub

    ''' <summary>
    ''' 发送消息完毕
    ''' </summary>
    ''' <param name="writeEventArgs"></param>
    Private Sub ProcessSend(ByVal writeEventArgs As SocketAsyncEventArgs)
        Dim oToken As AsyncClientToken = TryCast(writeEventArgs.UserToken, AsyncClientToken)
        If oToken Is Nothing Then
            Return
        End If

        RaiseEvent ClientSendOverEvent(Me, New ClientEventArgs(oToken))
        'FreeEventArgs(writeEventArgs)
        m_bufferManager.FreeBuffer(oToken.Buffer)
        oToken.Clear()
        RemoveHandler writeEventArgs.Completed, AddressOf IO_Completed
        writeEventArgs.Dispose()
        writeEventArgs.UserToken = Nothing
    End Sub
#End Region

#Region "关闭客户端"

    Private Sub FreeEventArgs(ByVal writeEventArgs As SocketAsyncEventArgs)
        Dim oToken As AsyncClientToken = TryCast(writeEventArgs.UserToken, AsyncClientToken)
        m_bufferManager.FreeBuffer(oToken.Buffer)
        oToken.Clear()
        m_readWritePool.Push(writeEventArgs)
    End Sub

    ''' <summary>
    ''' 关闭客户端
    ''' </summary>
    ''' <param name="e"></param>
    Private Sub CloseClientSocket(ByVal e As SocketAsyncEventArgs)
        Dim token As AsyncClientToken = TryCast(e.UserToken, AsyncClientToken)

        Try
            token.Socket.Shutdown(SocketShutdown.Send)
        Catch _ex As Exception
        End Try

        mClients.TryRemove(token.ClientID, token)
        token.Socket.Close()

        Interlocked.Decrement(m_numConnectedSockets) '关闭客户端
        RaiseEvent ClientCloseEvent(Me, New ClientEventArgs(token))

        FreeEventArgs(e)
        m_maxNumberAcceptedClients.Release()

    End Sub
#End Region

#Region "关闭服务器"
    ''' <summary>
    ''' 关闭服务器监听，但是没有关闭客户端连接
    ''' </summary>
    Public Sub Shutdown()
        If mServerIsRun = False Then Return
        '关闭服务器监听
        listenSocket.Close()
        mServerIsRun = False

        RaiseEvent ServerCloseEvent(Me, Nothing)
    End Sub

    ''' <summary>
    ''' 关闭所有客户端连接
    ''' </summary>
    Public Sub CloseAllClient()
        Task.Run(AddressOf CloseAllClientAsync)

    End Sub

    Public Sub CloseAllClientAsync()

        If m_numConnectedSockets > 0 Then
            Dim oClients = mClients.Values.ToArray()
            For Each oClient In oClients
                Try
                    If oClient.Socket IsNot Nothing Then
                        oClient.Socket.Close()
                        oClient.Socket.Dispose()
                    End If

                Catch ex As Exception
                    Trace.WriteLine("关闭连接时发生错误：" & ex.ToString())
                End Try


            Next
        End If
    End Sub
#End Region

    ''' <summary>
    ''' 获取所有客户端列表
    ''' </summary>
    ''' <returns></returns>
    Public Function GetClientList() As AsyncClientToken()
        Return mClients.Values.ToArray()
    End Function



End Class
